NFL Blog 3: Taking a closer look at QBR and quarterback run percentage
Laura Stickells
December 18, 2020
library(nflfastR)
library(espnscrapeR)
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──## ✓ ggplot2 3.3.2 ✓ purrr 0.3.4
## ✓ tibble 3.0.4 ✓ dplyr 1.0.2
## ✓ tidyr 1.1.2 ✓ stringr 1.4.0
## ✓ readr 1.4.0 ✓ forcats 0.5.0## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(xlsx)
library(ggplot2)
library(dplyr)
library(ggimage)
library(ggthemes)
library(scales)##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factorlibrary(furrr)## Loading required package: futurelibrary(gt)
library(DT)Load play by play data
#Takes about 45 seconds
seasons <- 1999:2020
pbp <- map_df(seasons, function(x) {
readRDS(url(paste0("https://raw.githubusercontent.com/guga31bb/nflfastR-data/master/data/play_by_play_",x,".rds")))
})Load QBR data
scrapeQBRData <- function(startyr, endyr, startwk, endwk) {
master <- data.frame()
for (i in endyr:startyr) {
season <- data.frame()
for (j in endwk:startwk) {
week <- get_nfl_qbr(week = j, season = i)
season <- rbind(week, season)
}
master <- rbind(master, season)
}
return(master)
}
scrapeQBRSeasonData <- function(startyr, endyr) {
master <- data.frame()
for (i in endyr:startyr) {
season <- get_nfl_qbr(season = i)
master <- rbind(master, season)
}
return(master)
}
qbr_by_season <- scrapeQBRSeasonData(2006, 2020)## Scraping QBR totals for 2020!## Scraping QBR totals for 2019!## Scraping QBR totals for 2018!## Scraping QBR totals for 2017!## Scraping QBR totals for 2016!## Scraping QBR totals for 2015!## Scraping QBR totals for 2014!## Scraping QBR totals for 2013!## Scraping QBR totals for 2012!## Scraping QBR totals for 2011!## Scraping QBR totals for 2010!## Scraping QBR totals for 2009!## Scraping QBR totals for 2008!## Scraping QBR totals for 2007!## Scraping QBR totals for 2006!qbr06to19 <- scrapeQBRData(2006, 2019, 1, 17)## Scraping weekly QBR for week 17 of 2019!## Scraping weekly QBR for week 16 of 2019!## Scraping weekly QBR for week 15 of 2019!## Scraping weekly QBR for week 14 of 2019!## Scraping weekly QBR for week 13 of 2019!## Scraping weekly QBR for week 12 of 2019!## Scraping weekly QBR for week 11 of 2019!## Scraping weekly QBR for week 10 of 2019!## Scraping weekly QBR for week 9 of 2019!## Scraping weekly QBR for week 8 of 2019!## Scraping weekly QBR for week 7 of 2019!## Scraping weekly QBR for week 6 of 2019!## Scraping weekly QBR for week 5 of 2019!## Scraping weekly QBR for week 4 of 2019!## Scraping weekly QBR for week 3 of 2019!## Scraping weekly QBR for week 2 of 2019!## Scraping weekly QBR for week 1 of 2019!## Scraping weekly QBR for week 17 of 2018!## Scraping weekly QBR for week 16 of 2018!## Scraping weekly QBR for week 15 of 2018!## Scraping weekly QBR for week 14 of 2018!## Scraping weekly QBR for week 13 of 2018!## Scraping weekly QBR for week 12 of 2018!## Scraping weekly QBR for week 11 of 2018!## Scraping weekly QBR for week 10 of 2018!## Scraping weekly QBR for week 9 of 2018!## Scraping weekly QBR for week 8 of 2018!## Scraping weekly QBR for week 7 of 2018!## Scraping weekly QBR for week 6 of 2018!## Scraping weekly QBR for week 5 of 2018!## Scraping weekly QBR for week 4 of 2018!## Scraping weekly QBR for week 3 of 2018!## Scraping weekly QBR for week 2 of 2018!## Scraping weekly QBR for week 1 of 2018!## Scraping weekly QBR for week 17 of 2017!## Scraping weekly QBR for week 16 of 2017!## Scraping weekly QBR for week 15 of 2017!## Scraping weekly QBR for week 14 of 2017!## Scraping weekly QBR for week 13 of 2017!## Scraping weekly QBR for week 12 of 2017!## Scraping weekly QBR for week 11 of 2017!## Scraping weekly QBR for week 10 of 2017!## Scraping weekly QBR for week 9 of 2017!## Scraping weekly QBR for week 8 of 2017!## Scraping weekly QBR for week 7 of 2017!## Scraping weekly QBR for week 6 of 2017!## Scraping weekly QBR for week 5 of 2017!## Scraping weekly QBR for week 4 of 2017!## Scraping weekly QBR for week 3 of 2017!## Scraping weekly QBR for week 2 of 2017!## Scraping weekly QBR for week 1 of 2017!## Scraping weekly QBR for week 17 of 2016!## Scraping weekly QBR for week 16 of 2016!## Scraping weekly QBR for week 15 of 2016!## Scraping weekly QBR for week 14 of 2016!## Scraping weekly QBR for week 13 of 2016!## Scraping weekly QBR for week 12 of 2016!## Scraping weekly QBR for week 11 of 2016!## Scraping weekly QBR for week 10 of 2016!## Scraping weekly QBR for week 9 of 2016!## Scraping weekly QBR for week 8 of 2016!## Scraping weekly QBR for week 7 of 2016!## Scraping weekly QBR for week 6 of 2016!## Scraping weekly QBR for week 5 of 2016!## Scraping weekly QBR for week 4 of 2016!## Scraping weekly QBR for week 3 of 2016!## Scraping weekly QBR for week 2 of 2016!## Scraping weekly QBR for week 1 of 2016!## Scraping weekly QBR for week 17 of 2015!## Scraping weekly QBR for week 16 of 2015!## Scraping weekly QBR for week 15 of 2015!## Scraping weekly QBR for week 14 of 2015!## Scraping weekly QBR for week 13 of 2015!## Scraping weekly QBR for week 12 of 2015!## Scraping weekly QBR for week 11 of 2015!## Scraping weekly QBR for week 10 of 2015!## Scraping weekly QBR for week 9 of 2015!## Scraping weekly QBR for week 8 of 2015!## Scraping weekly QBR for week 7 of 2015!## Scraping weekly QBR for week 6 of 2015!## Scraping weekly QBR for week 5 of 2015!## Scraping weekly QBR for week 4 of 2015!## Scraping weekly QBR for week 3 of 2015!## Scraping weekly QBR for week 2 of 2015!## Scraping weekly QBR for week 1 of 2015!## Scraping weekly QBR for week 17 of 2014!## Scraping weekly QBR for week 16 of 2014!## Scraping weekly QBR for week 15 of 2014!## Scraping weekly QBR for week 14 of 2014!## Scraping weekly QBR for week 13 of 2014!## Scraping weekly QBR for week 12 of 2014!## Scraping weekly QBR for week 11 of 2014!## Scraping weekly QBR for week 10 of 2014!## Scraping weekly QBR for week 9 of 2014!## Scraping weekly QBR for week 8 of 2014!## Scraping weekly QBR for week 7 of 2014!## Scraping weekly QBR for week 6 of 2014!## Scraping weekly QBR for week 5 of 2014!## Scraping weekly QBR for week 4 of 2014!## Scraping weekly QBR for week 3 of 2014!## Scraping weekly QBR for week 2 of 2014!## Scraping weekly QBR for week 1 of 2014!## Scraping weekly QBR for week 17 of 2013!## Scraping weekly QBR for week 16 of 2013!## Scraping weekly QBR for week 15 of 2013!## Scraping weekly QBR for week 14 of 2013!## Scraping weekly QBR for week 13 of 2013!## Scraping weekly QBR for week 12 of 2013!## Scraping weekly QBR for week 11 of 2013!## Scraping weekly QBR for week 10 of 2013!## Scraping weekly QBR for week 9 of 2013!## Scraping weekly QBR for week 8 of 2013!## Scraping weekly QBR for week 7 of 2013!## Scraping weekly QBR for week 6 of 2013!## Scraping weekly QBR for week 5 of 2013!## Scraping weekly QBR for week 4 of 2013!## Scraping weekly QBR for week 3 of 2013!## Scraping weekly QBR for week 2 of 2013!## Scraping weekly QBR for week 1 of 2013!## Scraping weekly QBR for week 17 of 2012!## Scraping weekly QBR for week 16 of 2012!## Scraping weekly QBR for week 15 of 2012!## Scraping weekly QBR for week 14 of 2012!## Scraping weekly QBR for week 13 of 2012!## Scraping weekly QBR for week 12 of 2012!## Scraping weekly QBR for week 11 of 2012!## Scraping weekly QBR for week 10 of 2012!## Scraping weekly QBR for week 9 of 2012!## Scraping weekly QBR for week 8 of 2012!## Scraping weekly QBR for week 7 of 2012!## Scraping weekly QBR for week 6 of 2012!## Scraping weekly QBR for week 5 of 2012!## Scraping weekly QBR for week 4 of 2012!## Scraping weekly QBR for week 3 of 2012!## Scraping weekly QBR for week 2 of 2012!## Scraping weekly QBR for week 1 of 2012!## Scraping weekly QBR for week 17 of 2011!## Scraping weekly QBR for week 16 of 2011!## Scraping weekly QBR for week 15 of 2011!## Scraping weekly QBR for week 14 of 2011!## Scraping weekly QBR for week 13 of 2011!## Scraping weekly QBR for week 12 of 2011!## Scraping weekly QBR for week 11 of 2011!## Scraping weekly QBR for week 10 of 2011!## Scraping weekly QBR for week 9 of 2011!## Scraping weekly QBR for week 8 of 2011!## Scraping weekly QBR for week 7 of 2011!## Scraping weekly QBR for week 6 of 2011!## Scraping weekly QBR for week 5 of 2011!## Scraping weekly QBR for week 4 of 2011!## Scraping weekly QBR for week 3 of 2011!## Scraping weekly QBR for week 2 of 2011!## Scraping weekly QBR for week 1 of 2011!## Scraping weekly QBR for week 17 of 2010!## Scraping weekly QBR for week 16 of 2010!## Scraping weekly QBR for week 15 of 2010!## Scraping weekly QBR for week 14 of 2010!## Scraping weekly QBR for week 13 of 2010!## Scraping weekly QBR for week 12 of 2010!## Scraping weekly QBR for week 11 of 2010!## Scraping weekly QBR for week 10 of 2010!## Scraping weekly QBR for week 9 of 2010!## Scraping weekly QBR for week 8 of 2010!## Scraping weekly QBR for week 7 of 2010!## Scraping weekly QBR for week 6 of 2010!## Scraping weekly QBR for week 5 of 2010!## Scraping weekly QBR for week 4 of 2010!## Scraping weekly QBR for week 3 of 2010!## Scraping weekly QBR for week 2 of 2010!## Scraping weekly QBR for week 1 of 2010!## Scraping weekly QBR for week 17 of 2009!## Scraping weekly QBR for week 16 of 2009!## Scraping weekly QBR for week 15 of 2009!## Scraping weekly QBR for week 14 of 2009!## Scraping weekly QBR for week 13 of 2009!## Scraping weekly QBR for week 12 of 2009!## Scraping weekly QBR for week 11 of 2009!## Scraping weekly QBR for week 10 of 2009!## Scraping weekly QBR for week 9 of 2009!## Scraping weekly QBR for week 8 of 2009!## Scraping weekly QBR for week 7 of 2009!## Scraping weekly QBR for week 6 of 2009!## Scraping weekly QBR for week 5 of 2009!## Scraping weekly QBR for week 4 of 2009!## Scraping weekly QBR for week 3 of 2009!## Scraping weekly QBR for week 2 of 2009!## Scraping weekly QBR for week 1 of 2009!## Scraping weekly QBR for week 17 of 2008!## Scraping weekly QBR for week 16 of 2008!## Scraping weekly QBR for week 15 of 2008!## Scraping weekly QBR for week 14 of 2008!## Scraping weekly QBR for week 13 of 2008!## Scraping weekly QBR for week 12 of 2008!## Scraping weekly QBR for week 11 of 2008!## Scraping weekly QBR for week 10 of 2008!## Scraping weekly QBR for week 9 of 2008!## Scraping weekly QBR for week 8 of 2008!## Scraping weekly QBR for week 7 of 2008!## Scraping weekly QBR for week 6 of 2008!## Scraping weekly QBR for week 5 of 2008!## Scraping weekly QBR for week 4 of 2008!## Scraping weekly QBR for week 3 of 2008!## Scraping weekly QBR for week 2 of 2008!## Scraping weekly QBR for week 1 of 2008!## Scraping weekly QBR for week 17 of 2007!## Scraping weekly QBR for week 16 of 2007!## Scraping weekly QBR for week 15 of 2007!## Scraping weekly QBR for week 14 of 2007!## Scraping weekly QBR for week 13 of 2007!## Scraping weekly QBR for week 12 of 2007!## Scraping weekly QBR for week 11 of 2007!## Scraping weekly QBR for week 10 of 2007!## Scraping weekly QBR for week 9 of 2007!## Scraping weekly QBR for week 8 of 2007!## Scraping weekly QBR for week 7 of 2007!## Scraping weekly QBR for week 6 of 2007!## Scraping weekly QBR for week 5 of 2007!## Scraping weekly QBR for week 4 of 2007!## Scraping weekly QBR for week 3 of 2007!## Scraping weekly QBR for week 2 of 2007!## Scraping weekly QBR for week 1 of 2007!## Scraping weekly QBR for week 17 of 2006!## Scraping weekly QBR for week 16 of 2006!## Scraping weekly QBR for week 15 of 2006!## Scraping weekly QBR for week 14 of 2006!## Scraping weekly QBR for week 13 of 2006!## Scraping weekly QBR for week 12 of 2006!## Scraping weekly QBR for week 11 of 2006!## Scraping weekly QBR for week 10 of 2006!## Scraping weekly QBR for week 9 of 2006!## Scraping weekly QBR for week 8 of 2006!## Scraping weekly QBR for week 7 of 2006!## Scraping weekly QBR for week 6 of 2006!## Scraping weekly QBR for week 5 of 2006!## Scraping weekly QBR for week 4 of 2006!## Scraping weekly QBR for week 3 of 2006!## Scraping weekly QBR for week 2 of 2006!## Scraping weekly QBR for week 1 of 2006!qbr20 <- scrapeQBRData(2020, 2020, 1, 14)## Scraping weekly QBR for week 14 of 2020!## Scraping weekly QBR for week 13 of 2020!## Scraping weekly QBR for week 12 of 2020!## Scraping weekly QBR for week 11 of 2020!## Scraping weekly QBR for week 10 of 2020!## Scraping weekly QBR for week 9 of 2020!## Scraping weekly QBR for week 8 of 2020!## Scraping weekly QBR for week 7 of 2020!## Scraping weekly QBR for week 6 of 2020!## Scraping weekly QBR for week 5 of 2020!## Scraping weekly QBR for week 4 of 2020!## Scraping weekly QBR for week 3 of 2020!## Scraping weekly QBR for week 2 of 2020!## Scraping weekly QBR for week 1 of 2020!qbr_by_game <- rbind(qbr20, qbr06to19)
qbr_by_game$game_week <- as.numeric(qbr_by_game$game_week)Cam Newton QBR by season compared to league average and Tom Brady.
avg_qbr <- mean(qbr_by_game$qbr_total)
qbr_by_season %>%
filter(name %in% c('Tom Brady', 'Cam Newton')) %>%
ggplot(aes(x = season, y = qbr_total, color = name)) +
geom_line(size = 1) +
geom_hline(yintercept = avg_qbr, color = "black", linetype = "dashed") +
geom_point(alpha=.7) +
theme_fivethirtyeight() +
theme(
legend.title = element_blank(),
strip.text = element_text(face = "bold"),
axis.title.y = element_text(),
axis.title.x = element_blank()
) +
labs(
y = "Total QBR",
title = "Quarterback rating by season",
subtitle = "Dotted line represents league average from 2006 to 2020",
caption = "Data: @espnscrapeR | Plot: @LauraStickells"
) +
scale_x_continuous(breaks = seq(min(qbr_by_season$season), max(qbr_by_season$season), by = 1))
Percent QB rushes for Newton and Brady by season.
pats_qb_graph <- pbp %>%
filter(epa != 0, passer %in% c('T.Brady','C.Newton') | rusher %in% c('T.Brady', 'C.Newton')) %>%
select(posteam, desc, play_type, qb_scramble, pass, rush, season, passer, rusher) %>%
mutate(
player = case_when(
!is.na(passer) ~ passer,
!is.na(rusher) ~ rusher
)
) %>%
group_by(season, player) %>%
summarise(
run_pct = sum(rush)/n(),
pass_pct = sum(pass)/n(),
n = n()
) %>%
ggplot(aes(x = season, y = run_pct, color = player)) +
geom_line(size = 1) +
geom_point(alpha=.7) +
theme_fivethirtyeight() +
theme(
legend.title = element_blank(),
strip.text = element_text(face = "bold"),
axis.title.y = element_text(),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 30)
) +
labs(
y = "Run Percentage",
title = "Quarterback Run Percentage by Season",
subtitle = "Does not include scrambles",
caption = "Data: @nflfastR | Plot: @LauraStickells"
) +
scale_x_continuous(breaks = seq(min(pbp$season), max(pbp$season), by = 1)) +
scale_y_continuous(labels = label_percent(accuracy = 1))## `summarise()` regrouping output by 'season' (override with `.groups` argument)pats_qb_graph
Plotly comparing percent of quarterback runs and QBR by week.
library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutpbp_name_fix <- pbp
### Don't run the lines below twice
pbp_name_fix$passer <- trimws(gsub(".", ". ", pbp_name_fix$passer, fixed = TRUE))
pbp_name_fix$rusher <- trimws(gsub(".", ". ", pbp_name_fix$rusher, fixed = TRUE))
significant_qbs <- c('C. Newton', 'D. Jones', 'K. Murray', 'L. Jackson')
significant_pbp <- pbp_name_fix %>%
filter(epa != 0, passer %in% significant_qbs | rusher %in% significant_qbs) %>%
select(posteam, desc, play_type, qb_scramble, pass, rush, season, passer, rusher, week, away_score, away_team, home_score, home_team) %>%
mutate(
player = case_when(
!is.na(passer) ~ passer,
!is.na(rusher) ~ rusher
)
) %>%
group_by(week, season, player, away_score, away_team, home_score, home_team) %>%
summarise(
run_pct = sum(rush)/n(),
pass_pct = sum(pass)/n(),
n = n()
)## `summarise()` regrouping output by 'week', 'season', 'player', 'away_score', 'away_team', 'home_score' (override with `.groups` argument)significant_qbrs <- qbr_by_game %>%
filter(short_name %in% significant_qbs)
data <- left_join(significant_pbp, significant_qbrs, by = c("player" = "short_name", "week" = "game_week", "season" = "season"))
write.csv(data, 'data.csv')
graph <- data %>%
filter(season == 2020, player == 'C. Newton') %>%
ggplot(aes(x = week, y = run_pct)) +
geom_line(size = 1, color = "gray") +
geom_point(aes(color = qbr_total, text= paste(away_team, away_score, " - ", home_team, home_score, "<br>", "QBR: ", qbr_total, "<br>", "Run: ", run_pct)), alpha=.7, size = 3) +
scale_colour_gradient(low = "gold", high = "green4", name = "QBR") +
theme(
strip.text = element_text(face = "bold"),
axis.title.y = element_text(),
axis.title.x = element_text(),
) +
labs(
y = "Percent Runs",
x = "Week",
title = "Percent of quarterback runs by week for Cam Newton 2020",
subtitle = "",
caption = "Data: @espnscrapeR | Plot: @LauraStickells"
) +
scale_x_continuous(breaks = seq(min(pbp$week), max(pbp$week), by = 1)) +
scale_y_continuous(labels = label_percent(accuracy = 1))## Warning: Ignoring unknown aesthetics: textggplotly(graph, tooltip = ("text"))Correlation between Newton’s QBR and run percentage.
pbp_name_fix <- pbp
### Don't run the lines below twice
pbp_name_fix$passer <- trimws(gsub(".", ". ", pbp_name_fix$passer, fixed = TRUE))
pbp_name_fix$rusher <- trimws(gsub(".", ". ", pbp_name_fix$rusher, fixed = TRUE))
all_qbs <- pbp_name_fix %>%
filter(passer != 'NA', cp!= 'NA', season == 2020) %>%
group_by(passer, passer_id) %>%
summarise(
plays = n()
) %>%
filter(plays >= 200) %>%
select(passer) %>%
arrange(passer) ## `summarise()` regrouping output by 'passer' (override with `.groups` argument)all_qbs <- all_qbs[['passer']]
pcts <- pbp_name_fix %>%
filter(epa != 0, passer %in% all_qbs | rusher %in% all_qbs, play_type != "qb_kneel") %>%
select(posteam, desc, play_type, qb_scramble, pass, rush, season, week, passer, rusher) %>%
mutate(
player = case_when(
!is.na(passer) ~ passer,
!is.na(rusher) ~ rusher
)
) %>%
group_by(player, season, week) %>%
summarise(
run_pct = sum(rush)/n(),
runs = sum(rush),
pass_pct = sum(pass)/n(),
passes = sum(pass)
)## `summarise()` regrouping output by 'player', 'season' (override with `.groups` argument)qbrs <- qbr_by_game %>%
filter(short_name %in% all_qbs)
table <- left_join(qbrs, pcts, by = c("short_name" = "player", "season" = "season", "game_week" = "week")) %>%
group_by("short_name") %>%
mutate(
n = n()
) %>%
filter(n >= 10) %>%
ungroup()
table %>%
filter(short_name %in% c('C. Newton')) %>%
ggplot(aes(x = run_pct, y = qbr_total, color = short_name)) +
stat_smooth(method = "lm", geom = "line", alpha = 0.5, se = FALSE, size = 1) +
geom_point(alpha=.7) +
theme_fivethirtyeight() +
theme(
legend.title = element_blank(),
strip.text = element_text(face = "bold"),
axis.title.y = element_text(),
axis.title.x = element_text()
) +
labs(
y = "Total QBR",
x = "Run Percentage",
title = "Total QBR compared to QB run percentage\nby game for Cam Newton",
subtitle = "The two variable's show a positive correlation",
caption = "Data: @espnscrapeR and @nflfastR | Plot: @LauraStickells"
) +
scale_x_continuous(breaks = seq(min(table$runs), max(table$runs), by = .05), labels = label_percent(accuracy = 1))## `geom_smooth()` using formula 'y ~ x'
Correlation table for all the leagues QBs.
cor_p_table <- data.frame(matrix(ncol=3, nrow=0, dimnames=list(NULL, c("QB", "Cor", "pvalue"))))
for (i in all_qbs) {
temp_table <- data.frame()
temp_table <- table %>%
filter(short_name == i)
res <- cor.test(temp_table$run_pct, temp_table$qbr_total)
new_row <- c(i, round(res$estimate, 2), round(res$p.value, 3))
cor_p_table[nrow(cor_p_table) + 1, ] <- new_row
}
cor_p_table <- transform(cor_p_table, Cor = as.numeric(Cor))
cor_p_table <- transform(cor_p_table, pvalue = as.numeric(pvalue))
cor_p_table %>%
arrange(desc(Cor)) %>%
gt() %>%
tab_header(
title = "Correlation Between QBR and QB Run %",
subtitle = "Significant correlations are highlighted"
) %>%
tab_options(
table.border.top.color = "white",
row.striping.include_table_body = FALSE
) %>%
tab_source_note(
source_note = "SOURCE: @nflfastR and @espnscrapR"
) %>%
cols_label(
QB = "PLAYER",
Cor = "CORRELATION",
pvalue = "P-VALUE"
) %>%
tab_style(
style = list(
cell_fill(color = "lightyellow")
),
locations = cells_body(
columns = vars(QB, Cor, pvalue),
rows = pvalue < .07)
) %>%
tab_style(
style = list(
cell_text(weight = "bold")
),
locations = cells_body(
columns = vars(QB, Cor, pvalue),
rows = QB == 'C. Newton')
)| Correlation Between QBR and QB Run % | ||
|---|---|---|
| Significant correlations are highlighted | ||
| PLAYER | CORRELATION | P-VALUE |
| K. Murray | 0.56 | 0.002 |
| D. Jones | 0.52 | 0.009 |
| N. Mullens | 0.43 | 0.097 |
| J. Herbert | 0.35 | 0.263 |
| N. Foles | 0.35 | 0.009 |
| S. Darnold | 0.20 | 0.247 |
| J. Goff | 0.19 | 0.134 |
| M. Ryan | 0.19 | 0.007 |
| D. Prescott | 0.18 | 0.146 |
| K. Cousins | 0.18 | 0.071 |
| C. Newton | 0.16 | 0.069 |
| G. Minshew II | 0.14 | 0.521 |
| D. Carr | 0.13 | 0.140 |
| A. Rodgers | 0.11 | 0.133 |
| J. Burrow | 0.10 | 0.788 |
| R. Wilson | 0.09 | 0.312 |
| D. Watson | 0.08 | 0.576 |
| R. Tannehill | 0.06 | 0.514 |
| A. Smith | 0.05 | 0.518 |
| B. Roethlisberger | 0.04 | 0.594 |
| T. Bridgewater | 0.04 | 0.770 |
| D. Brees | 0.02 | 0.725 |
| P. Rivers | 0.02 | 0.764 |
| P. Mahomes | 0.00 | 0.983 |
| T. Brady | 0.00 | 0.973 |
| B. Mayfield | -0.02 | 0.906 |
| M. Stafford | -0.03 | 0.739 |
| R. Fitzpatrick | -0.05 | 0.584 |
| A. Dalton | -0.06 | 0.509 |
| C. Wentz | -0.13 | 0.296 |
| J. Allen | -0.15 | 0.341 |
| L. Jackson | -0.33 | 0.060 |
| D. Lock | -0.39 | 0.170 |
| SOURCE: @nflfastR and @espnscrapR | ||
Quarterback run percentage for all QBs in 2020 with three or more games.
run_pct_2020 <- table %>%
filter(short_name %in% all_qbs, season == 2020) %>%
group_by(short_name, headshot_href, team) %>%
summarise(
run_pct = sum(runs)/(sum(passes)+sum(runs)),
runs = sum(runs),
games = n()
) %>%
filter(games >= 3) %>%
arrange(desc(run_pct))## `summarise()` regrouping output by 'short_name', 'headshot_href' (override with `.groups` argument)asp_ratio <- 1.618
run_pct_graph <- run_pct_2020 %>%
left_join(teams_colors_logos, by = c("team" = "team_abbr")) %>%
ggplot(aes(x = reorder(short_name, -run_pct) , y = run_pct)) +
geom_col(aes(fill = team_color, color = team_color), alpha = 0.7) +
geom_image(aes(image = headshot_href), size = 0.075, by = "width", asp = asp_ratio) +
scale_color_identity(aesthetics = c("color", "fill")) +
ggthemes::theme_fivethirtyeight() +
theme(
legend.position = "bottom",
legend.title = element_blank(),
strip.text = element_text(face = "bold"),
axis.title.y = element_text(),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 90)
) +
labs(
y = "Run Percentage",
title = "Quarterback Run Percentage in 2020",
subtitle = "For quarterbacks with three or more games",
caption = "Data: @nflfastR | Plot: @LauraStickells"
)
run_pct_graph
Used this to calculate a QB’s percent of total rushing attempts out of a team’s total rushes. Also used this to compare rushing vs. passing success. Found lots of interesting stuff, but the post was getting long so I stopped here. Could look further into this in the future.
pbp %>%
filter(season == 2020, epa != 0, posteam == "BAL", epa != 0, rush == 1) %>%
select(desc, down, week, yardline_100, success, epa, pass, rush, rusher, success) %>%
mutate(
count = n()
) %>%
group_by(rusher) %>%
summarise(
rushes = n(),
rush_pct = n()/count,
success = sum(success)/n()
) %>%
unique() %>%
arrange(desc(rushes))## `summarise()` regrouping output by 'rusher' (override with `.groups` argument)## # A tibble: 11 x 4
## # Groups: rusher [11]
## rusher rushes rush_pct success
## <chr> <int> <dbl> <dbl>
## 1 G.Edwards 109 0.287 0.459
## 2 J.Dobbins 101 0.266 0.376
## 3 L.Jackson 80 0.211 0.475
## 4 M.Ingram 63 0.166 0.413
## 5 J.Hill 10 0.0263 0.2
## 6 R.Griffin III 8 0.0211 0.625
## 7 T.McSorley 4 0.0105 0.25
## 8 D.Duvernay 2 0.00526 0.5
## 9 M.Brown 1 0.00263 0
## 10 M.Skura 1 0.00263 0
## 11 P.Ricard 1 0.00263 0pbp %>%
filter(season == 2020, epa != 0, rusher == 'L.Jackson' | passer == 'L.Jackson', down <= 4) %>%
select(desc, down, week, yardline_100, success, epa, pass, rush) %>%
filter(rush == 1) %>%
summarise(
rush_success = sum(success)/n(),
count = n()
)## # A tibble: 1 x 2
## rush_success count
## <dbl> <int>
## 1 0.475 80pbp %>%
filter(season == 2020, epa != 0, rusher == 'L.Jackson' | passer == 'L.Jackson', down <= 4) %>%
select(desc, down, week, yardline_100, success, epa, pass, rush) %>%
filter(pass == 1) %>%
summarise(
pass_success = sum(success)/n(),
count = n()
)## # A tibble: 1 x 2
## pass_success count
## <dbl> <int>
## 1 0.462 394